home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / 4cmp22s.zip / COMPAT.4TH < prev    next >
Text File  |  1994-10-30  |  2KB  |  70 lines
  1. 0 .IF 
  2.  
  3. The definitions in this file are intended for use in developing
  4. CFORTH compilable programs in an ANS Forth compatible interpretive
  5. environment.
  6.  
  7. The definitions are not necessarily sufficient to compile
  8. CFORTH programs, but they are a good start!
  9.  
  10. Tom Almy
  11. 8/94
  12. .THEN
  13.  
  14. ( This first group tends to be needed by any implementation )
  15. ( Convert compiler directives into NOOPs )
  16. : MSDOS  DROP ;
  17. : MSDOSEXE  2DROP ;
  18. : ROMABLE  2DROP DROP ;
  19. : IN/OUT  2DROP ;
  20. : PRIMITIVE  ;
  21. : CSEG  ;
  22. : DSEG  ;
  23. : ALIGNDATA  ;
  24. : INITIALIZE  ;
  25. : I80186 ;
  26. : I80386 ;
  27.  
  28. ( some more compiler functions that get aliased )
  29. : H:  [COMPILE] : ;
  30. : SEPSSEG?  FALSE ;
  31. : SEPDSEG?  FALSE ;  ( maybe??)
  32. : ALIGNED?  FALSE ;
  33.  
  34. ( CS=DS [maybe??] so these default to datasegment operations)
  35. : CS:  ; IMMEDIATE
  36. : CS:TYPE  TYPE ;
  37.  
  38. ( defining words for arrays and tables )
  39. : ARRAY  CREATE  CELLS ALLOT  DOES>  SWAP CELLS + ;
  40. : CARRAY  CREATE  ALLOT  DOES>  + ;
  41. : TABLE  CREATE DOES> SWAP CELLS + @ ;
  42. : CTABLE  CREATE DOES> + C@ ;
  43.  
  44. ( defining word for string constants )
  45. : SCONSTANT  CREATE  [CHAR] " WORD C@ CHAR+ ALLOT ;
  46.  
  47. ( compile strings into dictionary )
  48. : ,"  [CHAR]  PARSE SWAP OVER HERE SWAP MOVE  ALLOT ;
  49.  
  50. ( IMMEDIATE versions of HEX and DECIMAL )
  51. : [HEX]  HEX ; IMMEDIATE
  52. : [DECIMAL]  DECIMAL ; IMMEDIATE
  53.  
  54. ( Not typically defined )
  55. : CELL- 2 - ;
  56. : <-  SWAP ! ;
  57. : C<-  SWAP C! ;
  58. : CTRL  BL WORD 1+ C@ 31 AND ;
  59. : [CTRL] CTRL POSTPONE LITERAL ; IMMEDIATE
  60. : ',  ' , ;
  61. : ?LEAVE  POSTPONE IF POSTPONE LEAVE POSTPONE THEN ; IMMEDIATE
  62. : RANGE  OVER + SWAP ;
  63. : CSET  DUP C@ ROT OR C<- ;
  64. : ?CTEST  C@ AND 0<> ;
  65. : CRESET  DUP C@ ROT INVERT AND C<- ;
  66. : CTOGGLE  DUP C@ ROT XOR C<- ;
  67. : -ROT  ROT ROT ;
  68. : U/  0 SWAP  UM/MOD  NIP ;
  69. : ><  256 M* OR ;
  70.